Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d18/vis082s.arc/MAINR2.PAS

Pascal/Delphi Source File | 1991-04-18 | 6.5 KB | 274 lines

{$R-,S-,I-,D-,F+,V-,B-,N-,L+ }

unit mainr2;

interface

uses Dos,crt,gensubs,gentypes,modem,subs1,subs2,statret,configrt,overret1,
     textret,userret,mailret,lineedit,ansiedit,mainr1;

function reedit (var m:message; g:boolean):boolean;
function editor (var m:message; sendto,gettitle:boolean; sent,bs:mstr):integer;
procedure seekbdfile (n:integer);
procedure writebdfile (var bd:boardrec);
procedure writecurboard;
(*procedure addnews;*)
procedure sendmailto (uname:mstr; anon:boolean);
procedure addfeedback (var m:mailrec);
procedure hangupmodem;
procedure setupmodem;
procedure disconnect;

implementation

function reedit (var m:message; g:boolean):boolean;
begin
  if fseditor in urec.config
    then reedit:=ansireedit (m,g)
    else reedit:=linereedit (m,g);
  trimmessage (m)
end;

procedure seekbdfile (n:integer);
begin
  seek (bdfile,n);
  seek (bifile,n); che
end;

procedure writebdfile (var bd:boardrec);
begin
  write (bdfile,bd);
  write (bifile,bd.shortname)
end;

procedure writecurboard;
begin
  seekbdfile (curboardnum);
  writebdfile (curboard); che
end;

function uploadmsg:integer;
  var f:text;
      b:bulrec;
      tu:mstr;
      me:message;
      sub,ls:lstr;
      lne:integer;

  begin
    uploadmsg:=-2;
    If yes then Begin
    If local then Begin
      buflen:=80;
      writestr ('Enter Name and Path to Text File:');
      if length(input)<1 then exit;
      assign (f,input);
      reset (f);
      if ioresult <> 0 then begin
        writeln ('Cannot find Specified File!');
        exit
      end;
    end else begin
      writeln(^M^S'Ready to receive via Z-Modem Upload!');
      assign(f,configset.forumdi+'Message.Xyz');
      if exist(configset.forumdi+'Message.Xyz') then erase(f);
      delay(500);
      exec('DSZ.COM',' port '+strr(configset.useco)+' speed '+strlong(baudrate)+' rz '+configset.forumdi+'Message.Xyz');
      if dosexitcode<>0 then begin
        writeln(^G^G'Aborted!');
        if exist(configset.forumdi+'Message.Xyz') then erase(f);
        exit;
      end;
    end;
    lne:=0;
    reset(f);
    while not eof(f) do begin
      readln(f,ls);
      inc(lne);
      if lne>100 then begin
        Writeln(^G^G^S'You may NOT have more then 100 lines in a message!');
        textclose(f);
        if not local then erase(f);
        exit;
      end;
      me.text[lne]:=ls;
    end;
    me.anon:=false;
    me.numlines:=lne;
    me.note:=urec.usernote;
    if me.numlines < 1 then begin
      writeln (^R'Message not saved!');
      exit;
    end;
    b.line:=maketext(me);
    uploadmsg:=b.line;
    b.anon:=false;
    B.Where:=Configset.origin1;
    B.Where2:=Configset.origin2;
    B.Version:=NetMailVer;
    B.Cnet:=False;
    B.FidoNet:=False;
    B.Flag3:=False;
    B.Flag4:=False;
    B.Flag5:=False;
    B.Flag6:=False;
    B.Flag7:=False;
    B.Flag8:=False;
    B.RealName:=Urec.RealName;
    b.when:=now;
    b.leftby:=unam;
    b.status:='[ ha ]';
    b.recieved:=false;
    b.leftto:=tu;
    b.line:=lne;
    b.plevel:=ulvl;
(*    addbul(b);
    inc(newposts);
    inc(gnup);
    with curboard do if autodel<=numbuls then autodelete; *)
    writeln(^M^S'Message has been saved');
  end;
 End;

function editor (var m:message; sendto,gettitle:boolean; sent,bs:mstr):integer;
var post:boolean;

  function getthetitle:boolean;
  begin
    post:=true;
    m.anon:=false;
    getthetitle:=true;
    If okfortitle then begin
    buflen:=40;
    writestr (^M^P'Title'^R':');
      if length(input)=0 then begin
        getthetitle:=false;
        exit
      end;
      m.title:=input;
      End;
    okfortitle:=True;
    if gettitle then begin
      buflen:=30;
     if sendto and (length(sent)=1) then begin
        writestr(^M^M^P'Send to ['^R'CR/All'^P']:');
        if length(input)=0 then m.sendto:='All'
          else
        m.sendto:=input;
     end else m.sendto:='The SysOp''s';
      if bs='EMAIL' then begin
          m.title:='Announcement';
          m.sendto:=urec.handle;
          exit;
      end;
      if sent<>'0' then m.sendto:=sent;
     if bs<>'0' then begin
        m.title:=bs;
        exit;
     end;
      if ulvl>=configset.anonymousleve then begin
        buflen:=1;
        writestr ('Anonymous? *');
        m.anon:=yes
      end;
      writestr ('Upload a Prepared Message? *');
      if yes then begin
        editor:=uploadmsg;
        post:=false;
      end;
    end;
  end;

var b:boolean;
begin
{ If useansiup then Begin }
    editor:=-1;
    m.numlines:=0;
    m.note:=urec.usernote;
    if not sendto then begin
      m.sendto:='All';
      m.title:='Message to next user';
    end;
    if match(bs,'EMAIL') then m.title:='Announcement';
    b:=getthetitle;
    if not post then exit;
    if b then if
     reedit(m,gettitle) then
      editor:=maketext(m)
{ end;
  useansiup:=false; }
end;


procedure sendmailto (uname:mstr; anon:boolean);
var un:integer;
    me:message;
    line:integer;
    u:userrec;
begin
  if length(uname)=0 then exit;
  un:=lookupuser (uname);
  if un=0 then writeln ('User not found.') else begin
    if anon and (ulvl<configset.sysopleve) then uname:=configset.anonymousst;
    seek (ufile,un);
    read (ufile,u);
    if u.emailannounce>-1 then begin
      writehdr (u.handle+'''s Announcement');
      printtext (u.emailannounce)
    end;
    writehdr ('Sending mail to '+uname);
    line:=editor(me,false,true,uname,'0');
    if line>=0 then addmail (un,line,me)
  end
end;

procedure addfeedback (var m:mailrec);
var ffile:file of mailrec;
begin
  assign (ffile,configset.forumdi+'Feedback');
  reset (ffile);
  if ioresult<>0 then begin
    close (ffile);
    rewrite (ffile)
  end;
  seek (ffile,filesize(ffile));
  write (ffile,m);
  close (ffile);
  newfeedback:=newfeedback+1;
end;

procedure hangupmodem;
var tries:integer;
begin
  tries:=0;
    while carrier and (tries<5) do begin
     delay(500);
     hangup;
    tries:=tries+1
  end;
  setparam (configset.useco,baudrate,parity)
end;

procedure setupmodem;
begin
  write(direct,#27,'[0m');
    if carrier then exit;
  writeln (usr,^M^J'Setting up the modem...'^M^J^J);
  sendmodemstr (configset.modemsetupst,true);
end;

procedure disconnect;
begin
  if online then hangupmodem;
  online:=true;
  writelog (0,3,'');
  if (unum>0) and not disconnected then updateuserstats (true);
  disconnected:=true;
    forcehangup:=true;
  writestatus;
  hangup
end;

begin
end.